home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The World of Computer Software
/
The World of Computer Software.iso
/
miscpas.zip
/
NEWSPIRO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1986-02-07
|
10KB
|
554 lines
Program Spiro;
{ Place Cosine and Sine values in two arrays }
{ This way you can table lookup instead of }
{ calling a trig function. It's a LOT FASTER! }
const
CosArray: array[1..200] of real =
( 1.00000,
0.99951,
0.99803,
0.99556,
0.99211,
0.98769,
0.98229,
0.97592,
0.96858,
0.96029,
0.95106,
0.94088,
0.92978,
0.91775,
0.90483,
0.89101,
0.87631,
0.86074,
0.84433,
0.82708,
0.80902,
0.79016,
0.77051,
0.75011,
0.72897,
0.70711,
0.68455,
0.66131,
0.63742,
0.61291,
0.58779,
0.56208,
0.53583,
0.50904,
0.48175,
0.45399,
0.42578,
0.39715,
0.36813,
0.33874,
0.30902,
0.27899,
0.24869,
0.21814,
0.18738,
0.15644,
0.12533,
0.09411,
0.06279,
0.03141,
0.00000,
-0.03141,
-0.06279,
-0.09411,
-0.12533,
-0.15643,
-0.18738,
-0.21814,
-0.24869,
-0.27899,
-0.30902,
-0.33874,
-0.36812,
-0.39715,
-0.42578,
-0.45399,
-0.48175,
-0.50904,
-0.53583,
-0.56208,
-0.58778,
-0.61291,
-0.63742,
-0.66131,
-0.68455,
-0.70711,
-0.72897,
-0.75011,
-0.77051,
-0.79015,
-0.80902,
-0.82708,
-0.84433,
-0.86074,
-0.87631,
-0.89101,
-0.90483,
-0.91775,
-0.92978,
-0.94088,
-0.95106,
-0.96029,
-0.96858,
-0.97592,
-0.98229,
-0.98769,
-0.99211,
-0.99556,
-0.99803,
-0.99951,
-1.00000,
-0.99951,
-0.99803,
-0.99556,
-0.99212,
-0.98769,
-0.98229,
-0.97592,
-0.96858,
-0.96029,
-0.95106,
-0.94088,
-0.92978,
-0.91776,
-0.90483,
-0.89101,
-0.87631,
-0.86074,
-0.84433,
-0.82708,
-0.80902,
-0.79016,
-0.77052,
-0.75011,
-0.72897,
-0.70711,
-0.68455,
-0.66131,
-0.63743,
-0.61291,
-0.58779,
-0.56209,
-0.53583,
-0.50904,
-0.48176,
-0.45399,
-0.42578,
-0.39715,
-0.36813,
-0.33874,
-0.30902,
-0.27899,
-0.24869,
-0.21815,
-0.18739,
-0.15644,
-0.12534,
-0.09411,
-0.06279,
-0.03141,
0.00000,
0.03141,
0.06279,
0.09410,
0.12533,
0.15643,
0.18738,
0.21814,
0.24869,
0.27899,
0.30901,
0.33873,
0.36812,
0.39714,
0.42578,
0.45399,
0.48175,
0.50904,
0.53582,
0.56208,
0.58778,
0.61290,
0.63742,
0.66131,
0.68454,
0.70710,
0.72897,
0.75011,
0.77051,
0.79015,
0.80901,
0.82708,
0.84433,
0.86074,
0.87630,
0.89100,
0.90482,
0.91775,
0.92977,
0.94088,
0.95105,
0.96029,
0.96858,
0.97592,
0.98229,
0.98769,
0.99211,
0.99556,
0.99803,
0.99951);
SinArray: array[1..200] of real =
(0.00000,
0.03141,
0.06279,
0.09411,
0.12533,
0.15643,
0.18738,
0.21814,
0.24869,
0.27899,
0.30902,
0.33874,
0.36812,
0.39715,
0.42578,
0.45399,
0.48175,
0.50904,
0.53583,
0.56208,
0.58778,
0.61291,
0.63742,
0.66131,
0.68455,
0.70711,
0.72897,
0.75011,
0.77051,
0.79015,
0.80902,
0.82708,
0.84433,
0.86074,
0.87631,
0.89101,
0.90483,
0.91775,
0.92978,
0.94088,
0.95106,
0.96029,
0.96858,
0.97592,
0.98229,
0.98769,
0.99211,
0.99556,
0.99803,
0.99951,
1.00000,
0.99951,
0.99803,
0.99556,
0.99211,
0.98769,
0.98229,
0.97592,
0.96858,
0.96029,
0.95106,
0.94088,
0.92978,
0.91776,
0.90483,
0.89101,
0.87631,
0.86074,
0.84433,
0.82708,
0.80902,
0.79016,
0.77051,
0.75011,
0.72897,
0.70711,
0.68455,
0.66131,
0.63743,
0.61291,
0.58779,
0.56209,
0.53583,
0.50904,
0.48176,
0.45399,
0.42578,
0.39715,
0.36813,
0.33874,
0.30902,
0.27899,
0.24869,
0.21815,
0.18738,
0.15644,
0.12534,
0.09411,
0.06279,
0.03141,
0.00000,
-0.03141,
-0.06279,
-0.09411,
-0.12533,
-0.15643,
-0.18738,
-0.21814,
-0.24869,
-0.27899,
-0.30901,
-0.33874,
-0.36812,
-0.39715,
-0.42578,
-0.45399,
-0.48175,
-0.50904,
-0.53582,
-0.56208,
-0.58778,
-0.61290,
-0.63742,
-0.66131,
-0.68454,
-0.70710,
-0.72897,
-0.75011,
-0.77051,
-0.79015,
-0.80901,
-0.82708,
-0.84433,
-0.86074,
-0.87630,
-0.89100,
-0.90483,
-0.91775,
-0.92978,
-0.94088,
-0.95106,
-0.96029,
-0.96858,
-0.97592,
-0.98229,
-0.98769,
-0.99211,
-0.99556,
-0.99803,
-0.99951,
-1.00000,
-0.99951,
-0.99803,
-0.99556,
-0.99212,
-0.98769,
-0.98229,
-0.97592,
-0.96858,
-0.96029,
-0.95106,
-0.94088,
-0.92978,
-0.91776,
-0.90483,
-0.89101,
-0.87631,
-0.86074,
-0.84433,
-0.82708,
-0.80902,
-0.79016,
-0.77052,
-0.75011,
-0.72897,
-0.70711,
-0.68455,
-0.66132,
-0.63743,
-0.61291,
-0.58779,
-0.56209,
-0.53583,
-0.50905,
-0.48176,
-0.45399,
-0.42578,
-0.39715,
-0.36813,
-0.33874,
-0.30902,
-0.27900,
-0.24869,
-0.21815,
-0.18739,
-0.15644,
-0.12534,
-0.09411,
-0.06280,
-0.03142);
var
X1, X2, Y1, Y2, ITh, IK, IH, ColorNum: integer;
YWork,CB,A,B,C,Th,H,DeltaAngle: real;
Fudge1, Fudge2: real; { Fudge Factors for overflow bug }
CH: char;
OK : boolean;
Procedure Putem;
begin;
If X2 = -1000 then { skip, if first time }
else
Draw(X1,Y1,X2,Y2,ColorNum); { draw a line between two points }
If ITh < 66 then ColorNum := 1 { change colors }
else if ITh < 132 then ColorNum := 2 { every now and then }
else ColorNum := 3;
X2 := X1; Y2 := Y1; { save new as old }
end;
Procedure Spiro;
Begin;
Repeat
ColorNum := 1; { starting color and }
ITh := 1; { trig array pointer }
Repeat
H := CB * Th; { part of the equation }
If H > 6.28318 then
Repeat
H := H - 6.28318; { get between 0 and 2PI }
Until H < 6.28318
Else if H < 0.0 then
Repeat
H := H + 6.28318;
Until H > 0.0;
IH := Trunc(H/0.0314159)+1; { convert radians to trig pointer }
If IH < 1 then IH := 1 { don''t go too low or too high }
else If IH > 200 then IH := 200;
{ The following Fudge assignments are because a screwy }
{ integer overflow bug slips in if you let the plot continue }
{ for a long period of time. Rather than find out why, }
{ this is just a kludgy pass to get by. }
Fudge1 := ((C*CosArray[ITh]) - (B*CosArray[IH])) * 1.1;
Fudge2 := (C*SinArray[ITh]) - (B*SinArray[IH]);
If (ABS(Fudge1) > 32767) or (ABS(Fudge2) > 32767) then
else begin;
X1 := Trunc(Fudge1) + 160; { Get new X and Y }
Y1 := Trunc(Fudge2) + 100;
PutEm; { Plot Them }
end;
If KeyPressed then begin;
OK := true; {Stop Plotting}
ITh := 201;
end;
Th := Th + DeltaAngle; { bump radian angle }
{ To get better resolution, change the following statement }
{ to ITH := ITH + 1; Also, make the DeltaAngle change below }
{ This will give cleaner graphs, but will slow down the }
{ program by 100% }
ITh := ITh + 2; { bump trig pointer }
Until ITh > 200;
Until OK;
end;
begin {first time through}
X2 := -1000;
Y2 := -1000;
ClrScr;
{ See the better resolution statement above. Change this one }
{ to DeltaAngle := 0.0314159; Also make the ITH change above. }
{ As mentioned, this will improve resolution at the cost of }
{ execution speed. }
DeltaAngle := 0.0314159 * 2; { set radian angle increment }
GraphColorMode;
Palette(2);
Th := 0;
B := 13.0; { these A and B parameters }
A := 87.5; { work well for the title }
C := A - B; { screen. }
CB := C / B;
OK := false;
GoToXY(19,12);
Write('TURBO');
GoToXY(19,13);
Write('SPIRO');
GOTOXY(17,14);
Write('Key=Start');
Repeat { Plot the title spirograph }
Spiro;
If KeyPressed then OK := True;
Until OK;
Repeat
ClrScr;
Writeln;
Writeln('Written by: Joey Robichaux (CompuServe: 71336,336) ');
Writeln(' 1036 Brookhollow Drive');
Writeln(' Baton Rouge, La. 70810');
Writeln('*Note:');
Writeln('<"Ctrl" & "C" terminates program, <anykey> stops graph>');
{ For what its worth, when A is greater than B, you get hypercycloids. }
{ When B is greater than A, you get epicycloids. }
Repeat
GotoXY(1,8);
BufLen := 5;
Write('Please enter value between 1 and 100: ','':5);
GoToXY(39,8);
Read(B);
Until (B >= 1) and (B <= 100);
Repeat
GotoXY(1,9);
BufLen := 5;
Write('Please enter another between 1 and 100: ','':5);
GoToXY(41,9);
Read(A);
Until (A >= 1) and (A <= 100);
GraphColorMode;
Palette(2);
X2 := -1000; {First time again}
Y2 := -1000;
Th := 0;
C := A - B;
CB := C / B;
OK := false;
Repeat
Spiro; { start graphing }
If KeyPressed then OK := true;
Until OK;
Until true = false;
end.
